perm filename SUBR.PAL[U,VDS]2 blob
sn#300585 filedate 1977-08-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00024 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 .TITLE SUBR
C00008 00003 "GETSYM" - FETCHES THE DESCRIPTOR BLOCK FOR A GIVEN STRING NAME
C00013 00004 "SEEKNM" - DECODES NAME INTO PTR TO SYMBOL BLOCK
C00016 00005 "GETTR2" - IDENTIFIES TRANS NAME AND INITIALIZES VALUE IF NECESSARY
C00018 00006 "GETVAR"&"PRTVAR" - INTEGER VARIABLE ROUTINES
C00021 00007 "GTOKEN","PTOKEN" - LOCATES AND PRINTS SEPARATOR WORDS
C00024 00008 "GETALW" - DECODES ALWAYS SWITCH
C00025 00009 "GETAOP"&"PTSAOP" - DECODES AND PRINTS ARITHMETIC OPERATIONS
C00027 00010 "GETCMP"&"CHK__" - DECODING AND EVAL RTNS FOR COMPARISON OPERATORS
C00029 00011 RETURNS PTR TO LABEL DATA BLOCK IN R0 GIVEN STRING NAME IN SG
C00033 00012 "GETSTR" - SUBR. TO SAVE STRING POINTER AND ADVANCE SG REGISTER
C00034 00013 "PACNME" - SUBR. TO PACK A SYMBOLIC NAME INTO A OUTPUT BUFFER
C00036 00014 "PTRTRN" - SUBR. TO PRINT A TRANSFORMS NAME AND DATA
C00038 00015 "PTRANS" - SUBR. TO PRINT A TRANSFORMS X,Y,Z,O,A,T
C00040 00016 "PSTEP" - SUBR. TO PRINT MOTION INSTRUCTION OUT ON TTY
C00043 00017 "MODTRN" - SUBR. TO PERMIT MODIFICATION OF EXISTING TRANSFORMS
C00046 00018 "EVAL" - EVALUATES A 5TH ORDER POLYNOMIAL
C00049 00019 "TIMER" - COMPUTE TOTAL MOTION TIME
C00052 00020 "GETBLK" - FREE STORAGE ALLOCATOR
C00056 00021 "RELBLK" - RETURNS FREE STORAGE BLOCK
C00058 00022 "TYPERR" - TYPES OUT ERROR MESSAGES
C00061 00023 ERROR CODE BITS
C00064 00024 ERROR MESSAGE STRINGS
C00068 ENDMK
C⊗;
.TITLE SUBR
;"PUSARG" - DECODES A FUNCTION AND ITS ARGUMENTS
;THIS ROUTINES DECODES A STRING FUNCTION NAME AND LOCATES ITS SYMBOL
;DATA BLOCK. THE ARGUMENTS OF THE FUNCTION ARE THEN DECODED AND LEFT
;ON THE STACK. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #HASTAB,R0 ;PTR TO SYMBOL HASH TABLE
; MOV #TYPE,R1 ;TYPE OF FUNCTION TO DECODE
; JSR PC,PUSARG
; BCS ERROR ;SET IF ERROR OCCURS
;
;IF NO ERROR OCCURS, R0 ← PTR TO SYMBOL DATA BLOCK AND A BLOCK OF
;EIGHT WORDS ARE LEFT ON THE STACK. THE WORDS ON THE STACK ARE USED
;TO STORE THE FUNCTION ARGUMENTS THAT ARE DECODED. THE FIRST
;ARGUMENT HAS THE LOWEST CORE ADDRESS. IF AN ERROR OCCURS, THE C
;BIT IS SET, THE STACK IS LEFT UNALTERED AND R1 IS USED TO INDICATE
;THE TYPE OF ERROR:
;
; R1 = 0, NO SYMBOLIC FUNCTION NAME FOUND
; R1 ≠ 0, ERROR MESSAGES IN R1
;REGISTERS USED:
; ALL REGISTERS EXCEPT R4 ARE ALTERED
PUSARG: JSR PC,GETSYM ;GET THE FUNCTION SYMBOL DATA BLK
BCC GOTFUN
MOV R1,R1 ;ERROR CODE ALREADY SPECIFIED?
BGT 1$ ;YES
MOVB (SG),(SG) ;END OF LINE?
BEQ 1$
MOV #UNKFUN,R1 ;NO, MUST BE AN UNKNOWN FUNCTION NAME
1$: RTS PC
GOTFUN: SUB #MAXARG,SP ;LEAVE ROOM ON STACK FOR ARGUMENTS
MOV MAXARG(SP),(SP) ;SAVE RETURN ADDRESS
MOV R0,-(SP) ;SAVE PTR TO SYMBOL DATA BLOCK
TSTB NUMARG(R0) ;ANY ARGUMENTS TO DECODE?
BEQ PUSDNE ;NO
MOV SP,R3 ;PTR TO ARGUMENT STORAGE
CMP (R3)+,(R3)+
MOV R0,R2 ;ADDR OF ARGUMENT TYPE INDICATORS
ADD #FUNARG,R2
BR NXTARG
GETARG: BIC #177601,R0 ;WORD INDEX TO ARGUMENT TYPE
BIT #100,R0 ;TOKEN?
BEQ NOTTOK
BIC #100,R0 ;YES, SCAN FOR TOKEN
MOV TOKTBS(R0),R0
JSR PC,GTOKEN
BR .+6
NOTTOK: JSR PC,@ARGTAB(R0) ;GO DECODE REGULAR ARGUMENT
BCC GOTARG
TST R1 ;BRANCH IF SYNTAX ERROR
BNE ARGERR
BITB #1,(R2) ;ARG MISSING, ERROR IF NOT OPTIONAL
BEQ NOARG
CLR R0 ;DEFAULT = 0
GOTARG: TSTB (R2)+ ;NEED TO SAVE ARGUMENT?
BMI .+4
MOV R0,(R3)+ ;SAVE ARGUMENT VALUE
NXTARG: MOVB (R2),R0 ;NEXT ARGUMENT TYPE
BNE GETARG ;END OF LIST?
PUSDNE: MOV #BADLIN,R1 ;REST OF LINE SHOULD BE EMPTY
CMPB #' ,(SG)+ ;IGNOR SPACE CHAR
BEQ .-4
TSTB -(SG) ;EOL?
BNE ARGERR ;JUMP IF GARBAGE HERE
MOV (SP)+,R0 ;ALL DONE
CLC
RTS PC
NOARG: MOV #NOARGU,R1 ;INDICATE NO ARGUMENT FOUND
ARGERR: MOV 2(SP),R0 ;THIS IS THE RETURN ADDRESS
ADD #MAXARG+4,SP ;CLEAR STACK
SEC ;INDICATE ERROR
JMP (R0)
;END OF "PUSARG"
;"GETSYM" - FETCHES THE DESCRIPTOR BLOCK FOR A GIVEN STRING NAME
;THE FIRST WORD IN THE STRING POINTER BUFFER IS HASHED AND A SEARCH
;OF THE APPROPRIATE HASH BUCKET IS CON@UCTED. LEGAL SYMBOLS CAN AT
;MOST HAVE 6 CHARACTERS. THE FIRST CHARACTER MUST BE BETWEEN A-Z
;AND ALL OTHER CHARACTERS MUST BE EITHER ALPHABETIC (A-Z), NUMERIC (0-9),
;OR THE CHARACTER ".". A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #HASHTB,R0 ;PTR TO HASH TABLE
; MOV #TYPE,R1 ;NAME ID, EG. MOTION, MASTER
; MOV #STRING,SG ;STRING CONTAINING NAME
; JSR PC,GETSYM
; BCS ERROR ;SET IF ERROR
;
;IF SUCCESSFUL, R0 ← PTR TO SYMBOL DATA BLOCK AND SG IS LEFT
;POINTING AT THE BREAK CHARACTER. IF AN ERROR OCCURRED, THE C
;BIT IS SET AND R1 INDICATES THE TYPE OF ERROR:
;
; R1 = 0, NO SYMBOLIC NAME FOUND
; R1 > 0, TOO MANY CHARACTERS IN NAME, R1= ERROR CODE
; R1 < 0, NO MATCH FOR NAME FOUND, R0 ← PTR TO LAST DATA BLK LINK
; IN HASH BUCKET, R1 ← -# OF CHAR IN NAME, SG ← PTR TO
; FIRST CHARACTER IN NAME.
;REGISTERS USED:
; R0,R1,SG PASS ARGUMENTS AND MAY BE ALTERED
GETSYM: MOV R4,-(SP) ;SAVE REGISTERS
MOV R3,-(SP)
MOV R2,-(SP)
MOV R1,-(SP) ;SAVE SYMBOL TYPE
;HASH THE FIRST WORD
CMPB #' ,(SG)+ ;IGNOR ALL LEADING SPACE CHARACTERS
BEQ .-4
DEC SG ;POINT TO FIRST NON-SPACE CHARACTER
MOV SG,R4 ;SAVE STRING POINTER
MOV #7,R1 ;HASH AT MOST 6 CHARACTERS
CLR R2 ;FORM HASH IN HERE
BR HASH0 ;SYMBOLS START WITH A CHARACTER
HASH: CMPB #'.,(SG) ;IS IT A "."?
BEQ HASH1
CMPB #'0,(SG) ;INVALID CHAR IF LESS THAN ASC 0
BGT HASH2
CMPB #'9,(SG) ;0-9 ARE VALID CHARACTERS
BGE HASH1
HASH0: CMPB #'A,(SG) ;A-Z?
BGT HASH2
CMPB #'Z,(SG)
BLT HASH2
HASH1: MOVB (SG)+,R3 ;GET THE GOOD CHARACTER
ADD R3,R2 ;ELSE ADD CHARACTERS TOGETHER
SOB R1,HASH ;CHECK IF MORE THAN 6 CHAR. READ
MOV #BIGSYM,R1 ;INDICATE TOO MANY CHARACTERS IN WORD
BR GTSERR
HASH2: SUB #7,R1 ;CHECK IF ANY CHARACTERS FOUND
BEQ GTSERR ;EXIT IF NO WORD BEFORE BREAK CHAR.
BIC #177740,R2 ;USE 5 LSB AS HASH WORD INDEX
ASL R2
ADD R2,R0 ;ADD TO BASE ADDRESS OF TABLE
;GO SEARCH FOR SYMBOL
MOV R4,SG ;POINT TO START OF SYMBOL
MOV (R0),R3 ;TEST IF ANY SYMBOLS IN BUCKET
BEQ GTSERR
GETSM1: MOV R3,R0
BIT (SP),TYPBIT(R0) ;SAME TYPE OF SYMBOL?
BEQ 40$ ;NO
ADD #SYMNME,R3 ;COMPARE NAME
MOV R1,R2
NEG R2
20$: CMPB (R3)+,(SG)+
BNE 30$ ;BRANCH IF NOT SAME
SOB R2,20$
CMP #-6,R1 ;PERFECT MATCH IF 6 CHARACTERS
BEQ GTSDNE
CMPB (R3),#40 ;ELSE THIS BETTER BE A SHORT SYM.
BEQ GTSDNE
30$: MOV R4,SG
40$: MOV LINK(R0),R3 ;NEXT SYMBOL BLOCK
BNE GETSM1
ADD #LINK,R0
GTSERR: SEC ;INDICATE ERROR
GTSDNE: MOV (SP),(SP)+ ;DISCARD TYPE WORD
MOV (SP)+,R2 ;RESTORE REGISTERS
MOV (SP)+,R3
MOV (SP)+,R4
RTS PC
;END OF "GETSYM"
;"SEEKNM" - DECODES NAME INTO PTR TO SYMBOL BLOCK
;THESE ROUTINES DECODE THE NAMES OF PROGRAMS AND TRANSFORMATION
;VARIABLES INTO PTRS TO DATA SYMBOL BLOCKS. A SAMPLE CALL TO ONE
;OF THESE ROUTINES FOLLOWS:
;
; MOV #STRING,SG ;POINT TO INPUT STRING
; JSR PC,GETTRN ;NO ARGUMENTS REQUIRED
; BCS ERROR ;CHECK FOR ERROR RETURN
;
;IF A SYMBOLIC NAME IS FOUND A SYMBOL BLOCK IS ALLOCATED IF THE
;NAME IS NOT ALREADY DEFINED. IN EITHER CASE, THE C BIT IS LEFT
;CLEARED AND R0 ← PTR TO SYMBOL BLOCK. IF NO SYMBOLIC NAME IS
;FOUND, C IS SET AND R1← 0, OTHERWISE C SET AND R1 ← ERROR CODE.
;REGISTERS USED:
;
; R0,R1,SG PASSES ARGUMENTS AND ARE ALTERED
GETPRG: MOV #PROG,R1 ;LOOK FOR A PROGRAM NAME
MOV #7,R0 ;# OF WORDS IN SYMBOL BLOCK
BR SEEKNM
GETTRN: MOV #TRANS,R1 ;LOOK FOR A TRANSFORM NAME
MOV #6,R0
SEEKNM: MOV R3,-(SP)
MOV R2,-(SP)
MOV R1,-(SP)
MOV R0,-(SP)
MOV #VARTAB,R0 ;LOOK IN VARIABLE HASH TABLE
JSR PC,GETSYM ;DECODE THE SYMBOL
BCC GTTNX ;ALL DONE IF FOUND DEFINED SYMBOL BLK
MOV R1,R3 ;CHECK ERROR CODE
BPL GTTNX ;EXIT IF SYNTAX ERROR OR NO NAME
MOV R0,R2 ;SAVE PTR TO LAST LINK IN BUCKET
MOV (SP),R0 ;GET A F.S. BLK OF WORDS
JSR PC,GETBLK
BCS GTTNX ;EXIT IF NO F.S. LEFT
MOV R0,(R2) ;ADD SYMBOL TO HASH TABLE LIST
MOV R0,R1 ;INITIALIZE SYMBOL BLOCK
CMP (R1)+,(R1)+
MOV 2(SP),(R1)+
MOV R3,R2 ;GET NUMBER OF CHARACTERS IN NAME
NEG R3
MOVB (SG)+,(R1)+ ;SAVE SYMBOLIC NAME
SOB R3,.-2
ADD #6,R2 ;NUMBER OF SPACES TO FILL
BEQ GOTNME
MOVB #40,(R1)+ ;FILL SPACES
SOB R2,.-4
GOTNME: CLC
GTTNX: MOV (SP)+,(SP)+ ;DONT NEED THIS INFO ANYMORE
MOV (SP)+,R2
MOV (SP)+,R3
RTS PC
;END OF "GETTRN" & "GETPRG"
;"GETTR2" - IDENTIFIES TRANS NAME AND INITIALIZES VALUE IF NECESSARY
;THIS ROUTINE DECODES A TRANSFORM NAME IN THE SAME FASHION AS "GETTRN",
;BUT IN ADDITION, IT INITIALIZE THE TRANSFORMATION LOCATION TO THE
;CURRENT ARM POSITION IF THE TRANSFORM NAME IS FOLLOWED BY A "!".
GETTR2: JSR PC,GETTRN ;LOOK FOR A TRANSFORM NAME
BCS 20$ ;ERROR?
MOV R2,-(SP)
MOV R3,-(SP)
CMPB #' ,(SG)+ ;IGNOR TRAILING SPACE CHARACTERS
BEQ .-4
CMPB #'!,-(SG) ;INITIALIZE TRANS TO CURRENT POSITION?
BNE 10$
INC SG ;YES
MOV R0,R3 ;SET TRANS EQUAL TO CURRENT ARM LOCATION
JSR PC,HERESB
MOV R3,R0
BR .+4
10$: CLC ;SIGNAL TRANS NAME FOUND
MOV (SP)+,R3
MOV (SP)+,R2
20$: RTS PC
;"GETVAR"&"PRTVAR" - INTEGER VARIABLE ROUTINES
;THESE ROUTINES ARE USED TO DECODE AND PRINT INTEGER
;VARIABLES AND CONSTANTS. SAMPLE CALLS TO THESE ROUTINES
;FOLLOW:
;
; MOV #STRING,SG ;DECODE VAR/CONT
; JSR PC,GETVAR ;NO ARGUMENTS REQUIRED
; BCS ERROR ;CHECK FOR ERROR RETURN
;
; MOV #STRING,SG ;ADD VAR/CONT TO STRING
; MOV #WORDPTR,R0
; JSR PC,PTRVAR
;
;THE ERROR CODES RETURNED BY THESE ROUTINES ARE THE SAME AS
;THOSE OF "GETSYM".
;REGISTERS USED:
; R0,R1,SG PASS ARGUMENTS AND ARE ALTERED
GETVAR: JSR PC,GETVA2 ;LOOK FOR INTEGER VARIABLE
BCC GETVDN ;ALL DONE IF FOUND SYMBOL BLOCK
JSR PC,GETINT ;ELSE MIGHT BE A INTEGER CONSTANT
BCS GETVDN ;VALID INTEGER VARIABLE?
MOV R2,-(SP)
MOV R3,-(SP)
MOV R0,R3 ;YES, SEARCH PROPER HASH BUCKET
BIC #177740,R0 ;USE LOW 5 BITS FOR INDEX
ASL R0
ADD #VARTAB,R0
MOV R0,R2
MOV (R2),R0 ;TEST IF ANY SYMBOLS IN BUCKET
BEQ 30$
10$: MOV R0,R2
CMP R3,(R2)+ ;MATCHED INTEGER VALUE?
BNE 20$ ;NO
TSTB TYPBIT(R0) ;INTEGER CONSTANT?
BEQ 40$ ;PERFECT MATCH
20$: MOV (R2),R0 ;NEXT ITEM IN LIST
BNE 10$ ;END OF LIST?
30$: MOV #3,R0 ;YES, ADD CONSTANT TO LIST
JSR PC,GETBLK
BCS 40$ ;OUT OF FREE STORAGE?
MOV R0,(R2) ;LINK IN
MOV R3,(R0) ;AND SAVE VALUE AND TYPE
40$: MOV (SP)+,R3
MOV (SP)+,R2
GETVDN: RTS PC
GETVA2: MOV #INTVAR,R1 ;ONLY LOOK FOR AN INTEGER VARIABLE
MOV #6,R0
JSR PC,SEEKNM
RTS PC
PTRVAR: TSTB TYPBIT(R0) ;VARIABLE OR CONSTANT?
BEQ 1$
JSR PC,PACNMS ;VARIABLE
BR 2$
1$: MOV (R0),R0 ;CONSTANT
JSR PC,PTSINT
CLRB -(SG) ;DELETE DECIMAL POINT
2$: RTS PC
;END OF INTEGER VARIABLE ROUTINES
;"GTOKEN","PTOKEN" - LOCATES AND PRINTS SEPARATOR WORDS
;THESE ROUTINES ARE USED FOR SCANNING AN INPUT LINE FOR A SPECIFIC
;ASC WORD AND PUTTING THE WORD IN A SPECIFIED ASC STRING. A
;SAMPLE CALLING SEQUENCE TO THESE ROUTINES FOLLOWS:
;
; MOV #STRING,SG
; MOV #WORD,R0
; JSR PC,PTOKEN
;
; MOV #STRING,SG
; MOV #WORD,R0
; JSR PC,GTOKEN
; BCS ERROR ;SET IF WORD NOT FOUND
;
;THE POSSIBLE REGISTER STATES AFTER THE EXECUTION OF "GTOKEN"
;ARE AS FOLLOWS:
; R1=? C=0 STRING FOUND
; R1=0 C=1 NO STRING FOUND BEFORE EOL
; R1=ERROR C=1 NO STRING FOUND BEFORE A BREAK CHAR.
;SG IS ALWAYS LEFT POINTING TO THE FIRST CHARACTER FOLLOWING THE
;DESIRED STRING AND R0 IS GARBAGED.
;REGISTERS USED:
; R0,R1,SG ARE ALTERED
GTOKEN: CLR R1 ;ASSUME NO ERRORS
CMPB #40,(SG)+ ;IGNOR LEADING SPACE CHAR
BEQ .-4
TSTB -(SG) ;END OF STRING?
BEQ 2$
MOV #SYNERR,R1 ;ASSUME SYNTAX ERROR
1$: CMPB (R0)+,(SG)+ ;SAME CHARACTERS?
BNE 2$
TSTB (R0) ;END OF STRING?
BNE 1$ ;NO
BR .+4
2$: SEC
RTS PC
PTOKEN: MOVB (R0)+,(SG) ;PACK STRING FOLLOWED BY 0
BEQ 1$
CMPB #' ,(SG)+ ;SPACE CHARACTER?
BNE PTOKEN ;NO
CLRB -(SG) ;DONT PRINT TRAILING SPACES
1$: RTS PC
;DEFINED TOKENS, THESE CAN BE FOLLOWED BY ANY CHARACTER
KCOMMA: .ASCIZ /,/
KEQUAL: .ASCIZ /=/
;DEFINED TOKENS, THESE MUST BE FOLLOWED BY A SPACE CHARACTER
KINTO: .ASCIZ /INTO /
KTHEN: .ASCIZ /THEN /
KPROG: .ASCIZ /DEFPRO /
KBY: .ASCIZ /BY /
.EVEN
;END "GTOKEN","PTOKEN"
;"GETALW" - DECODES ALWAYS SWITCH
;THE WORD "ALWAYS" IS A OPTIONAL SWITCH THAT CAN FOLLOW CERTAIN
;INSTRUCTIONS. THIS ROUTINE RETURNS A POINTER TO THE "ALWAYS"
;SYMBOL BLOCK IF THE SWITCH IS PRESENT, ELSE IT RETURNS THE
;STANDARD ERROR CODES. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #STRING,SG ;POINT TO INPUT STRING
; JSR PC,GETSTR
;REGISTERS USED:
; R0,SG PASSES ARGUMENTS AND ARE ALTERED
GETALW: MOV #KALWAY,R0 ;ALWAYS
JSR PC,GTOKEN
MOV #SYMALW,R0 ;PTR TO SYMBOL BLOCK IF FOUND
RTS PC
SYMALW==.-SYMNME ;DUMMY SYMBOL BLOCK
KALWAY: .ASCII /ALWAYS/
.BYTE 0,0
;END OF "GETALW"
;"GETAOP"&"PTSAOP" - DECODES AND PRINTS ARITHMETIC OPERATIONS
;"GETAOP" RETURNS AN INDEX WHICH IDENTIFIES ONE OF THE ARITHMETIC
;OPERATIONS + - * % /. ELSE IF NO ARITHMETIC OPERATION IS PRESENT AND NO
;OTHER CHARACTERS ARE FOUND BEFORE THE END OF LINE THE INDEX IS ZERO,
;OTHERWISE THE STANDARD ERROR CODES ARE RETURNED. A SAMPLE CALLING
;SEQUENCE FOLLOWS:
;
; MOV #STRING,SG ;POINT TO INPUT STRING
; JSR PC,GETAOP
;
;"PTSAOP" ADDS THE ARITHMETIC OPERATION ASC REPRESENTATION TO THE
;CURRENT STRING.
;REGISTERS USED:
; R0,R1,SG PASSES ARGUMENTS AND ARE ALTERED
GETAOP: CMPB #' ,(SG)+ ;IGNOR LEADING SPACE CHARACTERS
BEQ .-4
CLR R0 ;ASSUME NO OPERATION FOUND
TSTB -(SG) ;EOL?
BEQ 3$ ;YES, ALL DONE
MOV #5,R0
1$: CMPB OPERS-1(R0),(SG);COMPARE TO ARITHMETIC OPERATORS
BEQ 2$
SOB R0,1$
MOV #NOOPER,R1 ;SIGNAL ERROR
SEC
BR 3$
2$: INC SG
ASL R0 ;CONVERT TO WORD INDEX
3$: RTS PC
PTSAOP: ASR R0 ;CONVERT TO BYTE INDEX
BEQ 1$ ;NOTHING TO DO?
MOVB OPERS-1(R0),(SG)+;PACK AWAY OPERATOR
CLRB (SG)
1$: RTS PC
OPERS: .ASCII \*/+-%\
.EVEN
;END OF "GETAOP"&"PTSAOP"
;"GETCMP"&"CHK__" - DECODING AND EVAL RTNS FOR COMPARISON OPERATORS
;"GETCMP" USES THE SYMBOL SCANNING ROUTINE "GETSYM" TO IDENTIFY ANY
;COMPARISON OPERATOR PRESENT. IT RETURNS THE STANDARD ERROR CODES IF
;NO OPERATOR IS FOUND ELSE A POINTER TO THE OPERATOR SYMBOL BLOCK IS
;RETURNED.
;
;THE COMPARISON OPERATOR ROUTINES EVALUATE THE STATE OF THE CPU CONDITION
;CODE BITS AND RETURN WITH THE C BIT CLEARED IF THE CONDITION IS SATISFIED
;ELSE THE C BIT IS SET.
GETCMP: MOV #FUNTAB,R0 ;DECODE OPERATOR
MOV #CMPOPR,R1
JSR PC,GETSYM
MOV #BADCMP,R1 ;ERROR CODE IF NECESSARY
RTS PC
CHKEQ: BEQ .+4
SEC
RTS PC
CHKNE: BNE .+4
SEC
RTS PC
CHKGT: BGT .+4
SEC
RTS PC
CHKGE: BGE .+4
SEC
RTS PC
CHKLT: BLT .+4
SEC
RTS PC
CHKLE: BLE .+4
SEC
RTS PC
;END OF COMPARISON OPERATOR RTNS
;RETURNS PTR TO LABEL DATA BLOCK IN R0 GIVEN STRING NAME IN SG
GETLBL: JSR PC,GETINT ;LABELS ARE INTEGER NUMBERS
BCS GETLDN
MOV R2,-(SP)
MOV R3,-(SP)
MOV #BADLBL,R1 ;ERROR CODE
MOV R0,R3 ;MUST BE IN THE RANGE 0 TO '77777
SEC
BLT 40$ ;SIGNAL IF OUT OF RANGE
MOV @#LPROG,R2 ;SEARCH PROG. LABEL LIST FOR LABEL
ADD #LABELS,R2
MOV (R2),R0 ;ANY LABELS DEFINED?
BEQ 30$
10$: MOV R0,R2
CMP R3,LABEL(R2) ;FOUND LABEL?
BEQ 40$ ;YES
20$: TST (R2)+ ;NEXT ITEM IN LIST
MOV (R2),R0
BNE 10$ ;END OF LIST?
30$: MOV #3,R0 ;YES, ADD CONSTANT TO LIST
JSR PC,GETBLK
BCS 40$ ;OUT OF FREE STORAGE?
MOV R0,(R2) ;LINK IN
MOV R3,LABEL(R0) ;AND SAVE LABEL NAME
40$: MOV (SP)+,R3
MOV (SP)+,R2
GETLDN: RTS PC
;PRINT THE LABEL OF AN INSTRUCTION
PRTLBL: JSR PC,FNDLBL ;GET LABEL DATA BLOCK
BCS 10$ ;NOT LABELED?
MOV LABEL(R1),R0
JSR PC,PRTINT
MOVB #' ,-1(SG) ;DONT WANT "." FOLLOWING LABEL
BR 20$
10$: MOV #7,R1 ;FILL WITH SPACE CHARACTERS
MOVB #' ,(SG)+
SOB R1,.-4
20$: RTS PC
;PRINT A LABEL ARGUMENT
PTSLBL: MOV LABEL(R0),R0 ;R0 ← LABEL
JSR PC,PTSINT
CLRB -(SG) ;DON'T WANT "." FOLLOWING LABEL
RTS PC
;GIVEN THE ADDRESS OF A INSTRUCTION IN R0, IF THE INSTRUCTION HAS A LABEL,
;THE LABEL DATA ADDRESS IS CLEARED. R1 IS GARBAGED
CLRLBL: JSR PC,FNDLBL ;GET LABEL DATA BLOCK
BCS .+4 ;NOT LABELED?
CLR (R1) ;CLEAR JUMP ADDRESS
RTS PC
;RETURNS TO F.S. ALL LABEL DATA BLOCKS OF CURRENT LABEL PROGRAM
;GARBAGES R0,R1,R2
DELLBL: MOV @#LPROG,R2 ;GET PTR TO LABEL LIST
ADD #LABELS,R2
BR 20$
10$: CLR (R2) ;ZERO LINKS
MOV R0,R2 ;RELEASE F.S. BLOCK
JSR PC,RELBLK
20$: MOV (R2),R0 ;ANY MORE LABELS TO DELETE?
BNE 10$ ;YES
RTS PC
;GIVEN THE ADDRESS OF A LABELED INSTRUCTION IN R0, THIS ROUTINE RETURNS
;A POINTER TO THE LABEL DATA BLOCK IN R1
FNDLBL: SEC ;LABELED INSTRUCTION?
BIT #1,2(R0)
BEQ 30$
MOV @#LPROG,R1 ;SEARCH FOR LABELED ADDR IN PROG LABEL LIST
MOV LABELS(R1),R1
BR 20$
10$: MOV LINK(R1),R1 ;MOVE TO NEXT LABEL
20$: CMP R0,(R1) ;FOUND LABEL?
BNE 10$ ;NO
30$: RTS PC
;END OF INSTRUCTION LABEL ROUTINES
;"GETSTR" - SUBR. TO SAVE STRING POINTER AND ADVANCE SG REGISTER
;THE STRING POINTER IS SAVED IN R0 AND THE POINTER IN THE SG
;REGISTER IS ADVANCED TO THE END OF STRING CHARACTER. A
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #STRING,SG ;POINT TO INPUT STRING
; JSR PC,GETSTR
;
;THIS ROUTINE NEVER RETURNS A ERROR CODE.
;REGISTERS USED:
; R0,SG PASSES ARGUMENTS AND ARE ALTERED
GETSTR: MOV SG,R0 ;SAVE STRING POINTER
TSTB (SG)+ ;ADVANCE TO END OF LINE
BNE .-2
DEC SG ;LEAVE IT POINTING AT A NULL
RTS PC
;END OF "GETSTR"
;"PACNME" - SUBR. TO PACK A SYMBOLIC NAME INTO A OUTPUT BUFFER
;THE SYMBOL DATA BLOCK ADDRESS FOR THE SYMBOL TO BE PACKED
;MUST BE LOADED INTO R0. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #SYMBLK,R0
; JSR PC,PACNME
;
;NO ERROR MESSAGE IS RETURNED BY THIS ROUTINE.
;REGISTERS USED:
;
; R0 PASSES ARGUMENT AND IS NOT MODIFIED
; R1,SG ARE GARBAGED
PACNME: CLR R1 ;PACK ALL 6 CHARACTERS
BR PACNM0
PACNMS: MOV #40,R1 ;DONT PACK SPACE CHARACTERS
PACNM0: MOV R0,-(SP)
BEQ 3$ ;NOTHING TO DO?
MOV R2,-(SP)
MOV #6,R2 ;SIX CHARACTERS AT MOST
ADD #SYMNME,R0 ;GET ADDRESS OF CHARACTERS
1$: CMPB R1,(R0) ;END?
BEQ 2$
MOVB (R0)+,(SG)+ ;PACK AWAY THAT NAME
SOB R2,1$
2$: MOV (SP)+,R2
3$: MOV (SP)+,R0
CLRB (SG) ;MARK END OF STRING
RTS PC
;END OF "PACNME"
;"PTRTRN" - SUBR. TO PRINT A TRANSFORMS NAME AND DATA
;THE TRANS' SYMBOL DATA BLOCK ADDRESS MUST BE LOADED INTO R0. A
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #TRNSYM,R0 ;LOAD TRANSFORM ADDRESS
; MOV #TFFLAG,R1 ;1 IF "TF" LISTING,ELSE 0
; JSR PC,PTRTRN
;
;AFTER EXECUTION OF PTRTRN, THE COMPUTED EULER ANGLES ARE LEFT IN
;THE ARRAY "EANGLE". THERE IS NO ERROR MESSAGE RETURNED.
;REGISTERS USED:
; R0,R1 PASS ARGUMENTS AND R1 IS MODIFIED
; SG ARE GARBAGED
PTRTRN: MOV R0,-(SP)
MOV #OUTBUF,SG ;PACK THE TRANS NAME IN HERE
MOV R1,-(SP)
BEQ NOTTF ;TF LISTING?
MOV #43124,(SG)+ ;YES, PACK "TF"
MOVB #40,(SG)+
NOTTF: JSR PC,PACNME
MOVB #' ,(SG)+
CLRB (SG)
TST (SP)+ ;NEED A COMMA IF "TF"
BEQ NOTTF2
MOVB #',,(SG)+
CLRB (SG)
NOTTF2: MOV #OUTBUF,SG ;TYPE THE NAME
JSR PC,TYPSTR
MOV (R0),R0 ;GET PTR TO TRANS DATA
BNE GOTDAT
MOV #PTRMES,SG ;SAY NOT DEFINED IF NO DATA
JSR PC,LINOUT
BR .+6
GOTDAT: JSR PC,PTRANS ;PRINT X,Y,Z,O,A,T
MOV (SP)+,R0
RTS PC
PTRMES: .ASCIZ /TRANSFORMATION DATA NOT YET DEFINED/
.EVEN
;END OF "PTRTRN"
;"PTRANS" - SUBR. TO PRINT A TRANSFORMS X,Y,Z,O,A,T
;THE TRANS DATA ADDRESS MUST BE LOADED INTO R0. A SAMPLE CALLING
;SEQUENCE FOLLOWS:
;
; MOV #TRANS,R0 ;LOAD TRANSFORM ADDRESS
; JSR PC,PTRANS
;
;AFTER EXECUTION OF PTRANS, THE COMPUTED EULER ANGLES ARE LEFT IN
;THE ARRAY "EANGLE". THERE IS NO ERROR MESSAGE RETURNED.
;REGISTERS USED:
; R0 PASSES ARGUMENT AND IS NOT MODIFIED
; R1,SG ARE GARBAGED
PTRANS: MOV R0,-(SP) ;SAVE TRANSFORM POINTER
MOV R2,-(SP)
MOV R3,-(SP)
MOV #EANGLE,R1 ;CONVERT TRANS TO EULER ANGLES
JSR PC,EULER
MOV #OUTBUF,SG ;POINT TO START OF OUTPUT STRING
MOV #EANGLE,R2
MOV #3,R3 ;SET LOOP COUNT TO OUTPUT X,Y,Z
PTRAN1: MOV (R2)+,R0 ;CONVERT DISTANCE TO ASC
JSR PC,PRTDIS
JSR PC,PRTCMA
SOB R3,PTRAN1
MOV #3,R3 ;SET LOOP COUNT TO OUTPUT O,A,T
PTRAN2: MOV (R2)+,R0 ;CONVERT ANGLES TO ASC
JSR PC,PRTANG
JSR PC,PRTCMA
SOB R3,PTRAN2
SUB #2,SG ;PUT IN A NULL CHARACTER
CLRB (SG)
MOV #OUTBUF,SG ;OUTPUT THE STRING
JSR PC,LINOUT
MOV (SP)+,R3 ;RESTORE REGISTERS
MOV (SP)+,R2
MOV (SP)+,R0
RTS PC
HTRANS: .ASCII / /
HTRAN2: .ASCII / X Y Z O/
.ASCIZ / A T/
.EVEN
;END OF "PTRANS"
;"PSTEP" - SUBR. TO PRINT MOTION INSTRUCTION OUT ON TTY
;A POINTER TO THE DATA BLOCK CONTAINING THE MOTION INSTRUCTION MUST
;BE LOADED INTO R1 AND THE STEP NUMBER MUST BE SET IN R0. IF THE
;DATA BLOCK POINTER IS NON-ZERO, THE MOTION INSTRUCTION IS CONVERTED
;TO ASC ALONG WITH ITS STEP NUMBER AND THEY ARE TYPED OUT.
;OTHERWISE, NO TYPE OUT OCCURS. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #STEPNUM,R0
; MOV #BLKPTR,R1
; JSR PC,PSTEP
;
;AT THE END OF EXECUTION, "OUTBUF" IS ALWAYS LEFT WITH AT LEAST
;THE STEP NUMBER CODED IN ASC. THERE IS NO ERROR MESSAGE
;RETURNED FROM THIS ROUTINE.
;REGISTERS USED:
;
; R0,R1 PASS ARGUMENTS AND R0 IS ALTERED
; SG IS GARBAGED
PSTEP: MOV R4,-(SP)
MOV R3,-(SP)
MOV R2,-(SP)
MOV R1,-(SP) ;SAVE STEP POINTER
MOV #OUTBUF-2,SG ;DONT NEED +/- OR 1ST DIG
JSR PC,PRTINT ;STEP NUMBER
MOV (SP),R0 ;ALL DONE IF NO INSTRUCTION
BEQ PSTDNE
MOV R0,R4
JSR PC,PRTLBL ;PACK LABEL VALUE
TST (R4)+
MOV (R4)+,R0 ;MOTION FUNC. SYMBOL BLOCK PTR
BIC #1,R0
JSR PC,PACNMS ;NAME TO ASCII
TSTB NUMARG(R0) ;ANY ARGUMENTS TO DECODE?
BEQ PSPTYP ;NO
MOV R0,R3 ;SPECIFICATIONS OF ARGUMENTS
ADD #FUNARG,R3
CMPB #STRING,(R3) ;SPECIAL CASE OF 1 STRING ARG
BNE NXTPAC
MOVB (R4)+,(SG)+ ;PACK AWAY STRING ARGUMENT
BNE .-2
BR PSPTYP
PACARG: BMI .+4 ;NEEDS ARGUMENT?
MOV (R4)+,R0 ;YES
MOVB #' ,(SG)+ ;SEPARATE ARGUMENTS WITH SPACE CHAR
BIC #177601,R1 ;CONVERT TO WORD INDEX
BIT #100,R1 ;TOKEN?
BEQ 1$
BIC #100,R1 ;YES
MOV TOKTBS(R1),R0
JSR PC,PTOKEN ;PACK TOKEN
BR NXTPAC
1$: JSR PC,@PRTTAB(R1) ;CONVERT ARGUMENT TO ASC
NXTPAC: MOVB (R3)+,R1 ;NEXT ARGUMENT TYPE
BNE PACARG ;END OF LIST?
PSPTYP: MOV #OUTBUF,SG ;TYPE THE MOTION COMMAND
JSR PC,LINOUT
PSTDNE: MOV (SP)+,R1
MOV (SP)+,R2
MOV (SP)+,R3
MOV (SP)+,R4
RTS PC
;END OF "PSTEP"
;"MODTRN" - SUBR. TO PERMIT MODIFICATION OF EXISTING TRANSFORMS
;THIS SUBROUTINE IS CALLED TO ALLOW THE USER TO EDIT EXISTING
;TRANSFORMS. THE ONLY REQUIRED ARGUMENT TO THIS ROUTINE IS A TRANS
;POINTER LOADED INTO REGISTER R0. EDITING IS CONTINUED INDEFINITLY
;UNTIL THE USER RESPONSES TO THE QUERY "CHANGES" WITH A NULL LINE
;(I.E. NO REQUESTED CHANGES ). A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #TRANS,R0
; JSR PC,MODTRN
;
;THERE IS NO ERROR RETURN FROM THIS ROUTINE
;REGISTERS USED:
; R0 PASSES ARGUMENT AND IS NOT MODIFIED
; R1,R2,R3,R4,SG ARE GARBAGED
MODTRN: MOV R0,-(SP)
MOV #HTRANS+7,SG ;TYPE OUT THE COLUMN HEADER
JSR PC,LINOUT
BR MODT1
CHGTRN: MOV #EANGLE,R1 ;CONVERT EULER ANGLES BACK TO TRANS
MOV (SP),R0
JSR PC,UNEUL
MODT1: MOV (SP),R0
JSR PC,PTRANS ;TYPE OUT THIS TRANSFORM
MOV #CHGMES,SG ;ASK FOR CHANGES
JSR PC,LINOUT
MOV #INBUF,SG ;READ IN THE CHANGES
JSR PC,INSTR
MOV #EANGLE,R4 ;EULER ANGLES ARE STORED IN HERE
CLR -(SP) ;KEEP TRACK OF ANY CHANGES
MOV #GETDIS,R2 ;READ IN THE THREE DISTANCES
MODT2: MOV #3,R3 ;SET LOOP COUNTER
MODT3: JSR PC,(R2)
BCC ISCORR ;BRANCH IF A CORRECTION WAS TYPED IN
TST R1 ;BRANCH IF ERROR ON INPUT
BNE MODERR
TST (R4)+ ;NO CHANGE MADE
BR NOCORR
ISCORR: MOV R0,(R4)+ ;CHANGE EULER ANGLE
INC (SP) ;INDICATE CHANGE MADE
NOCORR: JSR PC,CLRCMA ;SKIP OVER COMMA
BCC MODCOM ;BRANCH IF NO ERROR
MODERR: JSR PC,TYPERR ;TYPE INPUT ERROR MESSAGE
TST (SP)+
BR MODT1
MODCOM: SOB R3,MODT3 ;REPEAT FOR ALL NUMBERS
CMP #GETANG,R2 ;REPEAT FOR 3 ANGLES
BEQ MODT4
MOV #GETANG,R2
BR MODT2
MODT4: TST (SP)+ ;REPEAT IF CORRECTIONS MADE
BNE CHGTRN
MOV (SP)+,R0
RTS PC
CHGMES: .ASCIZ /CHANGE?/
.EVEN
;END OF "MODTRN"
;"EVAL" - EVALUATES A 5TH ORDER POLYNOMIAL
;"EVAL" COMPUTES THE DESIRED PERCENTAGE CHANGE IN SET POINTS BASED
;UPON THE FRACTION OF TIME THAT HAS ELAPSED SINCE THE START OF A
;MOTION. IF "PTIME" IS THE TIME FOR WHICH THE SET POINT EVALUATION
;IS DESIRED AND "TTIME" IS THE TOTAL MOTION TIME, THE DESIRED
;PERCENTAGE CHANGE IN SET POINT WILL BE:
;
; % CHANGE = 6.0*T↑5 -15*T↑4 +6*T↑3 -1
; WHERE T = PTIME/TTIME
;
;A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV PTIME,R0
; MOV #JTARAY,R1
; MOV TTIME,R2
; JSR PC,EVAL
;
;THE PERCENTAGE CHANGE IS RETURNED IN R0 WHERE 1.0 = '40000. IF PTIME
;IS GREATER THAN OR EQUAL TO TTIME, R0 IS SET TO ZERO AND THE
;"FINAL" FLAG BIT IS SET IN "ARMS".
;REGISTERS USED:
; R0,R2 PASS ARGUMENTS AND ARE ALTERED
; R1,R3 ARE GARBAGED
EVAL: CMP R2,R0 ;PAST END OF TRAJECTORY?
BLE TRJEND ;YES
CLR R1 ;% TIME = (PTIME/TTIME)
ASHC @#KM1,R0
DIV R2,R0
ASR R2 ;ROUND
SUB R2,R1
BMI .+4
INC R0
MOV #60000,R2 ;6.0 x T
MUL R0,R2
ROL R3
ADC R2
SUB #74000,R2 ;- 15.0
MUL R0,R2 ;x T
ASHC @#K1,R2
ROL R3
ADC R2
ADD #50000,R2 ;+ 10.0
MOV #3,R1 ;x T**3
TCUBE: MUL R0,R2
ASHC @#K2,R2
ROL R3
ADC R2
SOB R1,TCUBE
MOV R2,R0
SUB #40000,R0 ;-1.0
BR EVALDN
TRJEND: CLR R0 ;USE FINAL SET POINT
BIS #FINAL,@#ARMS ;SET POINT EVALUATION DONE
EVALDN: RTS PC
;END OF "EVAL"
;"TIMER" - COMPUTE TOTAL MOTION TIME
;DETERMINES THE TOTAL TIME REQUIRED FOR AN ARM MOTION BY COMPUTING
;THE INDIVIDUAL TIMES REQUIRED BY EACH JOINT AND TAKING THE LARGEST.
;A SAMPLE CALLING SEQUENCE TO THIS ROUTINA FOLLOWS:
;
; MOV #CHANGE,R0
; JSR PC,TIMER
; MOV R0,TIME
;
;THE ONLY ARCUMENT TO THIS ROUTIJE IS A POINTER TO A TABLE CONTAINING
;PHE CHANGE ANTHE JOINT ANGLES FOR THE DESIRED MOTION.
¬
;REGISTERS USED:
; R0 PASSES ARCUMENTS AND IS ALTERAD
; R1,R2,R3,R4 AR@
A∂¬%¬β∂∃λ~∀~))∪≠ Ht∪≠∨X∪$jX4Q' R4∀∪≠∨X∪$`YHj~∀∪5∨,∩GM! LY$b∩m)β¬→∀A∨ A5β1∪≠U~A∃∨%≥(A'A &4∀∪≠∨X∩FlYHh∩∩wM∪0A∃=∪≥)&↓)≡A)%≠
~∀%π→$∪H`∩∩w5β1∪≠U~A)%¬- %'∀A)∪≠∀~∃'!⊃→ t∪5∨,∩QHjRVYHd∩wπ=≠!+)∀A∃(AQ%β- SE TIME
BGE .+4
NEG R2
MUL (R1)+,R2
ROL R3 ;ROUND UP
ADC R2
CMP R2,R0 ;KEEP MAXIMUM TIME
BLE .+4
MOV R2,R0
SOB R4,SPDLP
TST R0 ;TIME = 0?
BEQ ZEROT
ADD @#EXTIME,R0 ;ADD A LITTLE TIME FOR SHORT MOVES
BVC .+6
MOV #77700,R0 ;SET TO MAX IF OVERFLOW
ZEROT: MOV @#NSPEED,R2 ;USER REQUESTED CHANGED?
BNE ISNSPD ;YES
MOV @#PSPEED,R2 ;PERMANENT CHANGE SET?
BEQ TMEDNE ;NO
ISNSPD: MUL R2,R0 ;YES, CORRECT
CLR @#NSPEED ;ONLY USE ONCE
ASHC @#KM9,R0 ;NORMALIZE
TST R0 ;SET TO MAX IF OVERFLOW
BNE MAXTME
MOV R1,R0
BPL .+6
MAXTME: MOV #77700,R0 ;MAXIMUM PERMITTED TIME
TMEDNE: MOV (SP)+,R5
RTS PC
;END OF "TIMER"
;"GETBLK" - FREE STORAGE ALLOCATOR
;RETURNS A BLOCK OF FREE STORAGE AREA EQUAL IN SIZE TO THE NUMBER OF
;WORDS REQUESTED. THE WORDS CONTAINED IN THE BLOCK ARE ALWAYS
;INITIALIZED TO ZERO. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #BLKSIZ,R0 ;NUMBER OF WORDS NEEDED
; JSR PC,GETBLK
; BCS ERROR ;NO FREE STORAGE LEFT
;
;ON EXITING, THIS ROUTINE LEAVES A POINTER TO THE START OF THE FREE
;STORAGE AREA IN R0. THIS IS A PTR TO THE FIRST WORD THAT CAN BE
;USED BY THE CALLER, NOT A PTR TO THE BOUNDARY TAG INFORMATION.
GETBLK: MOV R2,-(SP)
ASL R0 ;CONVERT FROM WORD TO BYTE COUNT
CMP (R0)+,(R0)+ ;+ 4 BYTES FOR BOUNDARY TAGS
MOV @#FSPTR,R1 ;PTR TO FIRST FREE BLOCK
BNE FRTRY ;INITIALIZE?
;INITIALIZE FREE STORAGE AREA
MOV #FREEST,R1 ;MARK AREA ABOVE AND BELOW F.S. BUSY
MOV #-1,(R1)+
MOV @#HICORE,R2
MOV #-1,(R2)
MOV R1,@#FSPTR ;MAKE WHOLE AREA INTO ONE LARGE BLOCK
MOV R2,-(SP) ;COMPUTE LENGTH OF LARGE BLOCK
SUB R1,(SP)
MOV (SP),(R1) ;LOWER BOUNDARY TAG
MOV (SP)+,-(R2) ;UPPER BOUNDARY TAG
;GET THE REQUIRED SPACE
FRTRY: CMP R1,@#HICORE ;OFF END OF FREE STORAGE?
BLO FR2 ;NO
MOV #FREEST,R1 ;YES, RESET PTR TO BEGINNING.
FR2: TST (R1) ;IS THIS AREA BUSY?
BLE FRNEG ;YES
CMP (R1),R0 ;ENOUGH ROOM HERE?
BGE FFOUND ;YES
ADD (R1),R1 ;ON TO NEXT, LOC[LTAG[NEXT]
BR FR1
FRNEG: SUB (R1),R1 ;LOC[LTAG[NEXT]
FR1: CMP R1,@#FSPTR ;CYCLED THROUGH ALL FREE STORAGE?
BNE FRTRY ;NO, TRY AGAIN
MOV #NOFRES,R1 ;RAN OUT OF ROOM, SIGNAL ERROR
MOV #CANPRO,@#ARMS
SEC
BR GETBDN
FFOUND: BEQ FEXACT ;IF 0 THEN EXACT FIT
MOV R1,R2 ;DIVID BLOCK INTO FOUND AND HOLE
ADD R0,R2 ;LOC[LTAG[HOLE]]
NEG R0 ;BUSY COUNT OF FOUND.
MOV R0,-2(R2) ;RTAG[FOUND] ← NEW FOUND COUNT
MOV R0,-(SP)
ADD (R1),R0 ;LTAG[HOLE] ← NEW HOLE COUNT
MOV R0,(R2)
MOV R2,@#FSPTR ;LOC[LTAG[HOLE]]
MOV R1,R2
TST -(R2)
ADD (R1),R2 ;LOC[RTAG[HOLE]].
MOV R0,(R2) ;RTAG[HOLE] ← NEW HOLE COUNT
MOV (SP)+,(R1)+ ;LTAG[FOUND] ← NEW FOUND COUNT
BR FRRET
FEXACT: MOV R1,R2
ADD (R1),R2 ;LOC[RTAG[FOUND]]
NEG (R1)+ ;SET BOUNDARY TAGS TO BUSY
NEG -(R2)
FRRET: MOV R1,R0 ;LOC[LTAG[FOUND]] + 1.
MOV -2(R0),R2
NEG R2 ;LENGTH COUNT IN WORDS
ASR R2
SUB #2,R2
CLR (R1)+ ;CLEAR THE BLOCK
SOB R2,.-2
GETBDN: MOV (SP)+,R2
RTS PC
;END OF "GETBLK"
;"RELBLK" - RETURNS FREE STORAGE BLOCK
;THIS IS CALLED TO RELEASE A BLOCK OF FREE STORAGE AREA FROM USE. A
;SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #BLOCK,R0 ;PTR TO BLOCK TO BE RELEASED
; JSR PC,GETBLK
;
;NO ERROR MESSAGE IS RETURNED BY THIS ROUTINE
;REGISTERS USED:
; R0 PASSES ARGUMENTS AND R0 AND R1 ARE GARBAGED
RELBLK: TST -(R0) ;LTAG[BLOCK]
MOV R0,R1 ;LOC[LTAG[BLOCK]]
SUB (R0),R0 ;LOC[LTAG[HIGH]]
NEG (R1) ;SIGNAL NOT BUSY
TST -2(R1) ;IS LOW AVAILABLE?
BLT MERGR ;NO, CANNOT MERGE
ADD -2(R1),(R1) ;YES, LTAG[BLOCK] ← NEW COUNT
MOV (R1),-2(R0) ;RTAG[BLOCK] ← NEW COUNT
MOV R0,R1
SUB -2(R1),R1 ;R1 ← LOC[LTAG[LOW]]
MOV -2(R0),(R1) ;LTAG[LOW] ← NEW COUNT
MERGR: TST (R0) ;IS HIGH AVAILABLE?
BLT RLRET ;NO
ADD (R0),(R1) ;LTAG[BLOCK] ← NEW COUNT
CMP @#FSPTR,R0 ;WILL FSPTR POINT INTO VACUUM?
BNE RL1 ;NO
MOV R1,@#FSPTR ;YES, RESET FSPTR ← LOC[LTAG[BLOCK]]
RL1: ADD (R0),R0 ;R0 ← LOC[RTAG[HIGH]] + 2
RLRET: MOV (R1),-2(R0) ;RTAG[BLOCK] ← NEW COUNT
RTS PC
;END OF "RELBLK"
;"TYPERR" - TYPES OUT ERROR MESSAGES
;THE ERROR CODE MUST BE LOADED INTO R1 BEFORE ENTERING THIS
;ROUTINE. A SAMPLE CALLING SEQUENCE FOLLOWS:
;
; MOV #ERRCODE,R1
; JSR PC,TYPERR
;REGISTERS USED:
; R1 PASSES ARGUMENTS AND R1 & SG ARE ALTERED
TYPERR: MOV R0,-(SP)
MOV R2,-(SP)
MOV #MNOSOL,SG ;SPECIAL CASE OF NO SOLUTION?
BIT #NOSOL,R1
BNE 1$ ;YES
BIT #NOTIME,R1 ;TIME OUT ERROR?
BEQ REGERR
MOV #MNOTIM,SG ;YES
1$: JSR PC,TYPSTR ;TYPE ERROR MESSAGE
MOV #'0,R0 ;START WITH CODE= 0
MOV #OUTBUF,SG
BIC #NOSOL+NOTIME,R1;GET JOINT BITS
BEQ 3$ ;ERROR CODE = 0?
2$: INC R0
ASR R1
BCC 4$
3$: MOVB R0,(SG)+ ;SAVE JT #
MOVB #40,(SG)+
4$: BNE 2$
CLRB (SG)
BR TYPNUM ;TYPE OUT ERROR CODE
REGERR: MOV ERRMES(R1),SG ;PUT UP ERROR MESSAGE
CMP #UHALT,R1 ;USER HALT INSTRUCTION?
BNE TYPEDN ;NO
JSR PC,TYPSTR ;YES, TYPE 1ST PART OF MES
MOV #OUTBUF,SG ;GET SUBR NAME AND LINE NUMBER
MOV @#SUBPTR,R1
MOV (R1)+,R2 ;FINAL STEP PTR
MOV (R1),R0 ;CURRENT SUBR SYM BLK PTR
CMP #SUBSTK,R1 ;MAIN PROGRAM?
BNE 1$ ;NO, SUBR
MOV #"ST,(SG)+ ;PACK "STEP "
MOV #"EP,(SG)+
MOVB #' ,(SG)+
BR 2$
1$: JSR PC,PACNMS ;"NAME-"
MOVB #'-,(SG)+
2$: MOV R0,R1 ;COMPUTE FINAL STEP NUMBER
CLR R0
3$: MOV (R1),R1 ;KEEP MOVING
INC R0
CMP R1,R2 ;FOUND STEP?
BNE 3$ ;NO
JSR PC,PTSINT ;YES, CONVERT TO ASCII
TYPNUM: MOV #OUTBUF,SG ;NOW TYPE IT
TYPEDN: JSR PC,LINOUT
MOV (SP)+,R2
MOV (SP)+,R0
RTS PC
;END OF "TYPERR"
;ERROR CODE BITS
RELCNT ==0
INT IMPOSS ;IMPOSSIBLE ERROR MESSAGE
INT UNKFUN ;UNKNOWN FUNCTION NAME SPECIFIED
INT BIGSYM ;MORE THAN 6 CHARACTERS USED IN SYMBOL NAME
INT NOFRES ;FREE STORAGE EXHAUSTED
INT NOARGU ;NO ARGUMENT FOUND
INT NOCOMA ;STRANGE CHARACTER BEFORE COMMA
INT BADNUM ;INVALID NUMBER DECODED
INT ADCERR ;ADC NOT WORKING
INT NOPROG ;NO PROGRAM NAME SPECIFIED
INT BADSTP ;INVALID PROGRAM STEP NUMBER
INT NULPRG ;EMPTY PROGRAM, NO STEPS
INT NOTDAT ;NO TRANSFORMATION DATA
INT PANBUT ;PANIC BUTTON HIT
INT NOHDWR ;HARDWARE SERVO NOT ENABLED
INT CNTPRO ;CANT PROCEED
INT RUNERR ;RUNSUB TOOK TOO LONG TO EXECUTE
INT BADCLS ;HAND CLOSED TO FAR
INT BADJTN ;ILLEGAL JOINT NUMBER SPECIFIED
INT OUTRNG ;POSITION OUT OF RANGE
INT GOODBY ;EXITING TO ODT
INT UHALT ;USER PROGRAM HALTED
INT ABORT ;ABORT TYPEOUT
INT SYNERR ;SYNTAX ERROR WHILE SCANNING FOR TOKEN
INT GOODLD ;GOOD LOAD FROM HSR
INT FINI ;USER PROGRAM COMPLETED
INT BADFRE ;F.S. AREA ALL SCREWED UP
INT SUBERR ;SUBR STACK EXHAUSTED
INT RETERR ;TRIED RETURN FROM MAIN PROGRAM
INT CNTSGS ;CANT SINGLE STEP FROM THIS POINT
INT BADCMP ;BAD COMPARISON OPERATOR
INT BADLIN ;CANT INTERPRET INPUT LINE
INT BADLBL ;BAD LABEL
INT ARITHO ;ARITHMETIC OVERFLOW
INT NOOPER ;NO ARITHMETIC OPERATION FOUND
INT MISLBL ;BRANCH TO MISSING LABEL
INT DUPLBL
NOSOL =1000 ;NO VALID ARM SOLUTION
NOTIME =2000 ;FUNCTION TOOK TOO LONG TO EXECUTE
;OUTPUT STRINGS FOR ERROR CODES
ERRMES: .WORD MIMPOS, MUNKFU, MBIGSY, MNOFRE, MNOARG, MNOCOM
.WORD MBADNU, MADCER, MNOPRO, MBADST, MNULPR
.WORD MNOTDA, MPANBU, MNOHDW, MCNTPR, MRUNER, MBADCL
.WORD MBADJT, MOUTRN, MGOODB, MUHALT, MABORT, MSYNER
.WORD MGOODL, MFINI, MBADFR, MSUBER, MRETER, MCNTSG
.WORD MBADCM, MBADLI, MBADLB, MARITH, MNOOPE
.WORD MMISLB
.WORD MDUPLB
;ERROR MESSAGE STRINGS
MIMPOS: .ASCIZ /**SYSTEM ERROR, REPORT THIS TO VICTOR SCHEINMAN**/
MFINI: .ASCIZ /PROGRAM COMPLETED/
MNOARG: .ASCIZ /**NO ARGUMENT FOUND WHEN EXPECTED**/
MUNKFU: .ASCIZ /**UNDEFINED FUNCTION SPECIFIED**/
MBIGSY: .ASCIZ /**MORE THAN 6 CHARACTERS USED IN SYMBOL NAME**/
MNOFRE: .ASCIZ /**FREE STORAGE EXHAUSTED**/
MNOCOM: .ASCIZ /**UNEXPECTED CHARACTER BEFORE COMMA**/
MBADNU: .ASCIZ /**INVALID NUMBER ENCOUNTERED**/
MADCER: .ASCIZ /**ANALOG TO DIGITAL CONVERTED NOT WORKING**/
MNOPRO: .ASCIZ /**NO PROGRAM NAME SPECIFIED**/
MBADST: .ASCIZ /**INVALID SPECIFICATION OF PROGRAM STEPS**/
MNULPR: .ASCIZ /**NO PROGRAM STEPS DEFINED**/
MNOSOL: .ASCIZ /**REQUIRED ARM SOLUTION DOES NOT EXIST**, CODE=/
MNOTDA: .ASCIZ /**TRANSFORM POSITION NOT YET DEFINED**/
MPANBU: .ASCIZ /**SOMEONE HIT THE PANIC BUTTON**/
MNOHDW: .ASCIZ /**HARDWARE SERVO NOT ENABLED**/
MNOTIM: .ASCIZ /**FUNCTION TOOK TOO LONG TO EXECUTE**, CODE=/
MRUNER: .ASCIZ /**RUN-TIME FUNCTION CLOCK OVER RUN**/
MBADCL: .ASCIZ /**HAND CLOSED TOO FAR**/
MBADJT: .ASCIZ /**ILLEGAL JOINT NUMBER SPECIFIED**/
MOUTRN: .ASCIZ /**REQUIRED POSITION OUT OF RANGE**/
MGOODB: .ASCIZ /EXITING TO ODT!/
MUHALT: .ASCIZ /HALTED AT /
MCNTPR: .ASCII /**CAN'T PROCEED FROM THIS POINT, USE /
.ASCIZ /"EXEC" INSTRUCTION**/
MABORT: .ASCIZ /
ABORTED/
MSYNER: .ASCIZ /**ERROR WHILE SCANNING FOR TOKEN**/
MGOODL: .ASCIZ /LOADING COMPLETED/
MBADFR: .ASCIZ /**FREE STORAGE AREA IN WRONG FORMAT**/
MRETER: .ASCIZ /**ATTEMPTED TO EXECUTE A "RETURN" WHILE IN MAIN PROGRAM**/
MSUBER: .ASCIZ /**TOO MANY "GOSUB"'S EXECUTED**/
MCNTSG: .ASCII /**CAN'T SINGLE STEP FROM THIS POINT, USE /
.ASCIZ /"EXEC" INSTRUCTION**/
MBADCM: .ASCIZ /**ILLEGAL COMPARISON OPERATOR**/
MBADLI: .ASCIZ /**CAN'T INTERPRET INPUT LINE**/
MBADLB: .ASCIZ /**INVALID LABEL ENCOUNTERED**/
MARITH: .ASCIZ /**ARITHMETIC OVERFLOW**/
MNOOPE: .ASCIZ /**NO ARITHMETIC OPERATION FOUND WHERE EXPECTED**/
MMISLB: .ASCIZ /**ATTEMPTED BRANCH TO NON-EXISTANT LABEL**/
MDUPLB: .ASCIZ /**DUPLICATE LABEL DEFINED**/
.EVEN
;END OF ERROR MESSAGES